home *** CD-ROM | disk | FTP | other *** search
/ Aminet 15 / Aminet 15 - Nov 1996.iso / Aminet / dev / basic / ace24dist.lha / ace24.lha / prgs / Fractals / henon.b < prev    next >
Text File  |  1996-09-10  |  2KB  |  97 lines
  1. { Henon Attractors -- cf Becker & Dorfler, pp 62-64,68 }
  2.  
  3. const     xscreen=640,yscreen=400
  4.  
  5. const    maxReal = 1E+18    
  6. const    maxInt = 2147483647
  7. const    true = -1&
  8.  
  9. '..planetary Henon attractor data
  10. const    lt = -1.2
  11. const    rt = 1.2
  12. const    top = 1.2
  13. const    bottom = -1.2
  14. const     phaseAngle = 1.111
  15. const    x0 = 0.098
  16. const    y0 = 0.061
  17. const    dx0 = 0.04
  18. const    dy0 = 0.03
  19. const    orbitnumber = 40
  20. const    pointnumber = 700
  21.  
  22. on menu gosub handle_menu
  23. menu on
  24.   
  25. sub set_universal_point(xw,yw)
  26.   xs = ((xw-lt) * xscreen / (rt-lt)) 
  27.   ys = (yw-bottom) * yscreen / (top-bottom)
  28.   pset (xs,ys)
  29. end sub
  30.  
  31. sub HenonAttractor
  32. single    cosA,sinA
  33. single    xNew,yNew,xOld,yOld
  34. single    deltaxperpixel,deltayperpixel
  35. longint    i,j
  36. longint    ok1,ok2
  37. shortint pcolr
  38.  
  39.   cosA = cos(phaseAngle) : sinA = sin(phaseAngle)
  40.   xOld = x0 : yOld = y0    '..starting point of first orbit
  41.   deltaxperpixel = xscreen/(rt-lt)
  42.   deltayperpixel = yscreen/(top-bottom)
  43.  
  44.   for j=1 to orbitnumber 
  45.     i=1
  46.     '..set foreground pen color
  47.     pcolr = (pcolr + 1) mod 3 
  48.     color pcolr+1
  49.     while i <= pointnumber 
  50.       if (abs(xOld) <= maxReal) and (abs(yOld) <= maxReal) then
  51.       xNew = xOld*cosA - (yOld - xOld*xOld)*sinA
  52.     yNew = xOld*sinA + (yOld - xOld*xOld)*cosA
  53.     ok1 = (abs(xNew-lt) < maxInt/deltaxperpixel)
  54.     ok2 = (abs(top-yNew) < maxInt/deltayperpixel)
  55.     if ok1 and ok2 then
  56.       set_universal_point(xNew,yNew)
  57.     end if    
  58.     xOld = xNew
  59.     yOld = yNew
  60.       end if  
  61.       i = i + 1
  62.     wend
  63.     xOld = x0 + j * dx0
  64.     yOld = y0 + j * dy0
  65.   next        
  66. end sub
  67.  
  68. { ** main ** }
  69. screen 1,xscreen,yscreen,3,4
  70. window 1,"Planetary Henon Attractor",(0,0)-(xscreen,yscreen),0,1
  71.  
  72. palette 0,0,0,0        '..black
  73. palette 1,1,1,1        '..white
  74. palette 2,0,1,0        '..green
  75. palette 3,1,0,0        '..red
  76. palette 4,1,1,0.13    '..yellow
  77. palette 5,1,0.13,0.93    '..violet
  78.  
  79. menu 1,0,1,"Project"
  80. menu 1,1,1,"Quit","Q"
  81.  
  82. HenonAttractor
  83.  
  84. while true
  85.   sleep
  86. wend
  87.  
  88. END
  89.  
  90. handle_menu:
  91.   if menu(0) = 1 and menu(1) = 1 then 
  92.     window close 1
  93.     screen close 1
  94.     STOP
  95.   end if
  96. return
  97.